home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / condom.arc / FCBIN.PAS < prev   
Pascal/Delphi Source File  |  1988-06-05  |  9KB  |  291 lines
  1. {
  2.               FCBIN.PAS vers 1.01 - June 1, 1988
  3.            PUBLIC DOMAIN - JIM MURPHY - 74030,2643
  4.  
  5.   Program to compare two files to determine if they are different
  6.   or identical.  The difference between this and FC.EXE that comes
  7.   with MS-DOS is; this program sends errorlevel codes that can be
  8.   accessed within a batch file.  It sends an errorlevel of zero (0)
  9.   if the files are identical, and a one (1), if they are different.
  10.   This program just reports what the general differences are, ie.
  11.   Date, Length, Bytes.  It also tells you the position of the first
  12.   byte at which the files differ.  You can determine where the report
  13.   will be sent by designating an output file, but if no output file
  14.   is designated, the report is sent to the screen.  You can also
  15.   suppress the output report by using '/s' on the command line right
  16.   after invoking this file.  An errorlevel code is always sent regard-
  17.   less of whether the command line option '/s' is used.
  18.  
  19.     FCBIN |/s| <file1> <file2> |outputfile|
  20.  
  21.   Two filenames to compare are required, and they must be either named
  22.   differently, or in different directories, or on different disks.
  23.   Use lpt1 as an output file to send the report to the printer.
  24. }
  25.  
  26.  
  27. PROGRAM FCBIN;
  28.  
  29. uses dos,crt;
  30.  
  31. const
  32.   buffmax=255;       { This is the Max size, as buffers are strings }
  33.  
  34. type
  35.   results=(same,flength,fbyte,fdate);
  36.   fnstr=string[65];
  37.  
  38. var
  39.   file1,file2:file;
  40.   outfile:text;
  41.   exitsave:pointer;
  42.   iocode:word;
  43.   result:set of results;
  44.   stopout,fdiff:boolean;
  45.   param1,fname1,fname2,outfn:fnstr;
  46.   date1,date2:longint;
  47.   length1,length2:longint;
  48.   buffsize:word;
  49.   buffer1,buffer2,buffert:string[buffmax];
  50.   i:longint;
  51.   freads,lastfread:longint;
  52.   errorcnt:longint;
  53.  
  54.  
  55. procedure getparams;
  56. begin
  57.   if paramcount<>0 then param1:=paramstr(1);
  58.   if (paramcount<2) or (paramcount>4) or
  59.     ((param1[1]<>'/') and (paramcount>3)) or
  60.     ((param1[1]='/') and ((paramcount<3) or (paramcount>4)))then begin
  61.     writeln('Incorrect parameters.');
  62.     writeln('Correct syntax is: fcbin |/s| <file1> <file2> |outputfile|');
  63.     writeln('/s = suppress all output');
  64.     writeln('Errorlevel is always output:');
  65.     writeln('0 = Files Identical');
  66.     writeln('1 = Files different');
  67.     writeln('A different date will not cause an errorlevel of 1 to');
  68.     writeln('be output, but the differences will be sent to the');
  69.     writeln('outputfile, where all differences will show.');
  70.     writeln('If no outputfile is specified then output is to the screen.');
  71.     halt;
  72.   end else
  73.   begin
  74.     stopout:=false;
  75.     if param1[1]<>'/' then begin
  76.       fname1:=paramstr(1);
  77.       fname2:=paramstr(2);
  78.       if paramcount=3 then outfn:=paramstr(3) else outfn:='con';
  79.     end else begin
  80.       if (param1='/S') or (param1='/s') then stopout:=true;
  81.       fname1:=paramstr(2);
  82.       fname2:=paramstr(3);
  83.       if paramcount=4 then outfn:=paramstr(4) else outfn:='con';
  84.     end;
  85.     if (fname1=fname2) or (fname1=outfn) or (fname2=outfn) then
  86.     begin
  87.       writeln('Duplicate filenames not allowed');
  88.       halt(0);
  89.     end;
  90.   end;
  91. end;  { end getparams }
  92.  
  93.  
  94. procedure prepfiles;
  95. begin
  96.   assign(file1,fname1);
  97.   assign(file2,fname2);
  98.   if not stopout then begin
  99.     assign(outfile,outfn);
  100.     {$I-}
  101.     rewrite(outfile);
  102.     {$I+}
  103.     iocode:=ioresult;
  104.     if iocode<>0 then begin
  105.       writeln('Output File Opening Error!');
  106.       halt(iocode);
  107.     end;
  108.   end;
  109.   {$I-}
  110.   reset(file1,1);
  111.   {$I+}
  112.   iocode:=ioresult;
  113.   if iocode<>0 then begin
  114.     writeln('File #1 Opening Error!');
  115.     halt(iocode);
  116.   end;
  117.   {$I-}
  118.   reset(file2,1);
  119.   {$I+}
  120.   iocode:=ioresult;
  121.   if iocode<>0 then begin
  122.     writeln('File #2 Opening Error!');
  123.     halt(iocode);
  124.   end;
  125. end;  { end prepfiles }
  126.  
  127.  
  128. procedure report;
  129. begin
  130.   if same in result then exitcode:=0 else exitcode:=1;
  131.   if not stopout then begin
  132.     {$I-}
  133.     writeln(outfile,'FCBIN: File #1:',fname1,' - File #2:',fname2);
  134.     if same in result then
  135.       writeln(outfile,'FCBIN: Files are identical')
  136.     else writeln(outfile,'FCBIN: Files are different');
  137.     if fdate in result then
  138.       writeln(outfile,'FCBIN: Files dates/times are different');
  139.     if flength in result then
  140.       writeln(outfile,'FCBIN: Files lengths are different');
  141.     if fbyte in result then
  142.       writeln(outfile,'FCBIN: Files bytes are different at byte #: ',errorcnt);
  143.     {$I+}
  144.     iocode:=ioresult;
  145.     close(outfile);
  146.     if iocode<>0 then begin
  147.       writeln('Output File Writing Error!');
  148.       halt(iocode);
  149.     end;
  150.   end;
  151.   close(file1);
  152.   close(file2);
  153.   halt(exitcode);
  154. end;  { end report }
  155.  
  156.  
  157. procedure quickchek;
  158. begin
  159.   result:=[same];
  160.   getftime(file1,date1);
  161.   getftime(file2,date2);
  162.   if date1<>date2 then result:=result+[fdate];
  163.   if filesize(file1)<>filesize(file2) then begin
  164.     result:=result+[flength];
  165.     result:=result-[same];
  166.     fdiff:=true;
  167.   end;
  168. end;  { end quickchek }
  169.  
  170.  
  171. procedure errcnt;
  172. begin
  173.   errorcnt:=0;
  174.   if freads>0 then if (buffsize<>lastfread) or (lastfread=0) then
  175.     errorcnt:=(i-1)*buffmax
  176.   else errorcnt:=i*buffmax;
  177.   for i:=1 to length(buffer1) do
  178.     if buffer1[i]<>buffer2[i] then begin
  179.       errorcnt:=errorcnt+i;
  180.       exit;
  181.     end;
  182. end;  { end errcnt }
  183.  
  184.  
  185. procedure blkread;
  186. var
  187.   nread1,nread2:word;
  188.  
  189. begin
  190.   {$I-}
  191.   blockread(file1,buffer1,buffsize,nread1);
  192.   blockread(file2,buffer2,buffsize,nread2);
  193.   {$I+}
  194.   iocode:=ioresult;
  195.   if iocode=0 then begin
  196.     buffert[1]:=buffer1[0];                        { All this stuff is necessary }
  197.     buffer1[0]:=chr(nread1);                       { because blockread starts    }
  198.     buffert[0]:=#1;                                { filling a string variable   }
  199.     buffert:=buffert+copy(buffer1,1,buffsize-1);   { at position [0] in the      }
  200.     buffer1:=buffert;                              { string, which is supposed   }
  201.     buffert[1]:=buffer2[0];                        { to contain the length byte. }
  202.     buffer2[0]:=chr(nread2);
  203.     buffert[0]:=#1;
  204.     buffert:=buffert+copy(buffer2,1,buffsize-1);
  205.     buffer2:=buffert;
  206.     if buffer1<>buffer2 then begin
  207.       result:=result-[same];
  208.       result:=result+[fbyte];
  209.       fdiff:=true;
  210.       errcnt;
  211.     end;
  212.   end else begin
  213.     writeln('File1/2 Reading Error!');
  214.     halt(iocode);
  215.   end;
  216. end;  { end blkread }
  217.  
  218.  
  219. procedure compare;
  220. begin
  221.   fdiff:=false;
  222.   quickchek;
  223.   if not fdiff then begin
  224.     freads:=filesize(file1) div buffmax;
  225.     lastfread:=filesize(file1) mod buffmax;
  226.     buffsize:=sizeof(buffer1)-1;
  227.     for i:=1 to freads do
  228.       if not fdiff then blkread else exit;
  229.     if lastfread<>0 then begin
  230.       buffsize:=lastfread;
  231.       blkread;
  232.     end;
  233.   end;
  234. end;  { end compare }
  235.  
  236.  
  237. {$F+}
  238. procedure fcexit;  {$F-}
  239. begin
  240.   if exitcode>=2 then begin
  241.     sound(1000); delay(500); nosound;
  242.     write('Error #',iocode,' - ');
  243.     case exitcode of
  244.         2:writeln('File not found.');
  245.         3:writeln('Path not found.');
  246.         4:writeln('Too many open files.');
  247.         5:writeln('Access denied.');
  248.         6:writeln('Invalid file handle.');
  249.         8:writeln('Insufficient memory.');
  250.        11:writeln('Invalid format.');
  251.        15:writeln('Invalid drive number.');
  252.        18:writeln('No more files.');
  253.        19:writeln('Disk is write protected.');
  254.        20:writeln('Bad disk unit.');
  255.        21:writeln('Drive not ready.');
  256.        23:writeln('CRC error in data.');
  257.        25:writeln('Disk seek error.');
  258.        26:writeln('Not an MS-DOS disk.');
  259.        27:writeln('Sector not found.');
  260.        28:writeln('Printer out of paper.');
  261.        29:writeln('Write fault.');
  262.        30:writeln('Read Fault.');
  263.       100:writeln('Disk read error.');
  264.       101:writeln('Disk write error.');
  265.       150:writeln('Disk is write protected.');
  266.       151:writeln('Unknown unit.');
  267.       152:writeln('Drive not ready.');
  268.       154:writeln('CRC error in data.');
  269.       156:writeln('Disk seek error.');
  270.       157:writeln('Unknown media type.');
  271.       158:writeln('Sector not found.');
  272.       159:writeln('Printer out of paper.');
  273.       160:writeln('Device write fault.');
  274.       161:writeln('Device read fault.');
  275.       162:writeln('Hardware failure.');
  276.     else writeln('Unknown error.');
  277.     end;
  278.   end;
  279.   exitproc:=exitsave;
  280. end;  { end fcexit }
  281.  
  282.  
  283. BEGIN
  284.   exitsave:=exitproc;
  285.   exitproc:=@fcexit;
  286.   getparams;
  287.   prepfiles;
  288.   compare;
  289.   report;
  290. END.
  291.